00100		DIMENSION II(1000),JJ(1000),KK(1000),LL(1000),KP(5),NN(4000)
00200		COMMON KP,NP,NN
00300		IMP(I)=IABS(NN(I)/100000000)
00400	1	JE=0
00500		MN=0
00600		IP=-1
00700		MO=0
00800		NZ=10
00900		IM=0
01000		NF=1
01100		CALL DPYCLR
01200		CALL TYPLOC(-350,-511)
01300		DO 407 I=1,4
01400	407	KP(I)='     '
01500		CALL DPYSET(4,LL,1000)
01600		CALL DPYSET(3,KK,1000)
01700		CALL DPYSET(2,JJ,1000)
01800		CALL DPYSET(1,II,1000)
01900		MN=0
02000	2	TYPE 5
02100	5	FORMAT(' TYPE:<CR>;TO DRAW NEW PICTURE.'/
02200		1' OR TYPE IN NAME TO USE OLD PICTURE.'/)
02300		ACCEPT 3,NAM
02400	3	FORMAT(A5)
02500		IF(NAM.EQ.'     ')GO TO 140
02600	   	IF(.NOT.LOOKD(NAM))GO TO 2
02700	515	CALL IFILE(1,NAM)
02800		READ(1)LE,(NN(K),K=MN+1,MN+LE)
02900		MN=MN+LE
03000		IP=-1
03100		IF(MO.NE.'P')GO TO 517
03200		MO=100000000
03300		DO 518 K=MN-LE+1,MN
03400		MP=1
03500		IF(NN(K))MP=-1
03600		NN(K)=IABS(NN(K))
03700	518	NN(K)=MP*(NP*MO+(MOD(NN(K),MO)))
03800		GO TO 503
03900	517	DO 388 K=1,MN
04000		NP=IMP(K)
04100		CALL SETPOG(NP)
04200		CALL INXY(NX,NY,K)
04300		MP=1
04400		IF(NN(K))MP=-1
04500	388	CALL IPEN(NX,NY,MP,NZ)
04600	   	DO 193 I=1,4
04700		KP(I)='VIS  '
04800	193	CALL DPYOUT(I)
04900		CALL SETPOG(1)
05000	140	NP=1
05100		CALL IPOG(NZ)
05200	
05300	211	NS=0
05400	120	LV=0
05500	144	CALL SETCUR(NX,NY,LV)
05600		IF(NS)TYPE 6
05700	6	FORMAT(' :'$)
05800		ACCEPT 103,M,N
05900	103	FORMAT(2A1)
06000		LX=NX
06100		LY=NY
06200		CALL RDCUR(NX,NY)
06300		IF(NC)GO TO 191
06400		IF(M.NE.' ')GO TO 11
06500	308	IF(LV.NE.0)GO TO 192
06600	301	CALL IPAK(NX,NY,MN,1,NZ)
06700		LV=1
06800		GO TO 144
06900	192 	CALL IPAK(NX,NY,MN,-1,NZ)
07000	341	N=NP
07100	278	CALL DPYOUT(N)
07200		KP(N)='VIS  '
07300	360	IF(IP)CALL IPOG(NZ)
07400	260	IF(NS)GO TO 144
07500		GO TO 120
07600	
07700	11	IF(M.EQ.':')GO TO 261
07800		IF(M.EQ.'.')GO TO 303
07900		IF(M.EQ.'W')GO TO 380
08000	  	IF(M.EQ.'H')GO TO 306
08100		IF(M.EQ.'V')GO TO 307
08200		IF(M.EQ.'B')GO TO 105
08300	  	IF(M.EQ.'C')GO TO 150
08400		IF(M.EQ.'+')GO TO 500
08500		IF(M.EQ.'-')GO TO 501
08600		IF(M.EQ.'*')GO TO 502
08700		IF(M.EQ.'A')GO TO 510
08800		IF(M.EQ.'E')GO TO 425
08900		IF(M.EQ.'(')GO TO 431
09000		IF(M.EQ.')')GO TO 432
09100	  	IF(M.EQ.'I'.OR.M.EQ.'S')GO TO 230
09200		IF(M.EQ.'X')GO TO 104
09300		IF(M.EQ.'Z')GO TO 580
09400		IF(M.NE.'P')GO TO 260
09500		IP=-1
09600		IF(N.EQ.'I')GO TO 258
09700		IF(N.EQ.'D')GO TO 340
09800		IF(N.NE.' ')GO TO 231
09900	259	NP=NP+1
10000		IF(NP.GT.4)NP=1
10100	251	CALL SETPOG(NP)
10200		GO TO 503
10300	303	IF(LV.EQ.0)GO TO 301
10400		CALL IPAK(NX,NY,MN,-1,NZ)
10500	333	KP(NP)='VIS  '
10600		IF(IP)CALL IPOG(NZ)
10700		CALL DPYOUT(NP)
10800		NX=LX
10900		NY=LY
11000		IF(.NOT.NC)GO TO 301
11100		NC=0
11200		GO TO 211
11300	306	NY=LY
11400		GO TO 308
11500	307	NX=LX
11600		GO TO 308
11700	230	IF(N.EQ.' ')GO TO 258
11800	231	IF(N.LT.'1'.OR.N.GT.'4')GO TO 255
11900		REREAD 408,M,N
12000	408	FORMAT(A1,I1)
12100		IF(M.EQ.'S')GO TO 278
12200	   	IF(M.NE.'I')GO TO 256
12300	257	KP(N)='     '
12400		CALL HYDPOG(N)
12500		IF(M.EQ.'P')GO TO 259
12600		GO TO 360
12700	255	IF(M.EQ.'P')GO TO 259
12800	258	IF(M.EQ.'S')GO TO 341
12900		N=NP
13000		GO TO 257
13100	256	NP=N
13200		GO TO 251
13300	261	IF(NS)GO TO 211
13400		NS=-1
13500		IF(LV.EQ.1)GO TO 192
13600		GO TO 301
13700	580	IF(IP)GO TO 581
13800		IP=-1
13900		GO TO 360
14000	581	IP=0
14100		N=5
14200		GO TO 257
14300	500	IF(NZ.EQ.20)GO TO 503
14400		NZ=NZ+1
14500		GO TO 503
14600	501	IF(NZ.EQ.5)GO TO 503
14700		NZ=NZ-1
14800		GO TO 503
14900	502	IF(NZ.EQ.10)GO TO 503
15000		NZ=10
15100	503	CALL CLRPOG(NP)
15200		CALL IDRA(MN,NZ)
15300		GO TO 335
15400	510	REREAD 516,MO,NAM
15500	516	FORMAT(1XA1,A5)
15600		IF(.NOT.LOOKD(NAM))GO TO 260
15700		GO TO 515
15800	340	CALL CLRPOG(NP)
15900		J=0
16000	400	J=J+1
16100	507	IF(J.GT.MN)GO TO 466
16200		MP=IMP(J)
16300		IF(MP.NE.NP)GO TO 400
16400		DO 401 I=J,MN-1
16500	401	NN(I)=NN(I+1)
16600		MN=MN-1
16700		GO TO 507
16800	466	IF(JE)GO TO 467
16900		IP=-1
17000		GO TO 431
17100	105	IF(MN.LT.1.OR.IMP(MN).NE.NP)GO TO 335
17200		IF(NP.EQ.1)II(2)=II(2)-1
17300		IF(NP.EQ.2)JJ(2)=JJ(2)-1
17400		IF(NP.EQ.3)KK(2)=KK(2)-1
17500		IF(NP.EQ.4)LL(2)=LL(2)-1
17600	        CALL ACCPOG(NP)
17700		MN=MN-1
17800	335	NS=0
17900		GO TO 341
18000	150	NC=-1
18100		IF(LV.NE.1)GO TO 301
18200	191	R=0
18300		RM=(NX-LX)**2+(NY-LY)**2
18400		RM=SQRT(RM)
18500		KX=LX+RM*SIND(R)
18600		KY=LY+RM*COSD(R)
18700		CALL IPAK(KX,KY,MN,1,NZ)
18800		DO 151 K=6,360,6
18900		R=K
19000		KX=LX+RM*SIND(R)
19100		KY=LY+RM*COSD(R)
19200	151	CALL IPAK(KX,KY,MN,-1,NZ)
19300		GO TO 333
19400	380	IF(LV.NE.1)GO TO 103
19500		REREAD 377,M,N
19600	377	FORMAT(A1,I2)
19700		IF(N.LT.4)N=100
19800		KN=N/10
19900		IF(KN.LT.2)KN=2
20000		DO 381 I=0,N,KN
20100		CALL IPAK(LX-N/2+I,LY-N/2+I,MN,1,NZ)
20200	381	CALL IPAK(NX-N/2+I,NY-N/2+I,MN,-1,NZ)
20300		GO TO 341
20400	425	I=0
20500	426	I=I+1
20600		IF(I.GT.MN)GO TO 211
20700	430	IF(IMP(I).NE.NP)GO TO 426
20800	548	CALL INXY(NX,NY,I)
20900		CALL SETCUR(NX*NZ/10,NY*NZ/10,1)
21000		TYPE 469
21100	469	FORMAT(' ERASE?'$)
21200		ACCEPT 103,M,N
21300		IF(M.EQ.' ')GO TO 426
21400		IF(M.EQ.'Y')GO TO 470
21500		IF(M.EQ.'I')GO TO 547
21600		IF(M.NE.'B')GO TO 211
21700	549	I=I-1
21800		IF(I.LT.1)GO TO 211
21900		IF(IMP(I).NE.NP)GO TO 549
22000		GO TO 548
22100	547	NN(I)=IABS(NN(I))
22200		GO TO 471
22300	470	MN=MN-1
22400		DO 428 K=I,MN
22500	428	NN(K)=NN(K+1)
22600	471	CALL CLRPOG(NP)
22700		CALL IDRA(MN,NZ)
22800		CALL DPYOUT(NP)
22900		GO TO 430
23000	431	NX=0
23100		NY=0
23200		NF=MN+1
23300		IM=0
23400		GO TO 211
23500	432	IF(IM.EQ.0)IM=MN
23600		DO 433 I=NF,IM
23700		CALL INXY(IX,IY,I)
23800		IX=NX+IX
23900		IY=NY+IY
24000		MP=1
24100		IF(NN(I))MP=-1
24200	433	CALL IPAK(IX,IY,MN,MP,NZ)
24300		GO TO 341
24400	
24500	104	CALL CLRCUR
24600		CALL IPOG(NZ)
24700		IP=-1
24800	   	TYPE 111
24900	111	FORMAT(' TYPE:<CR>;TO CONTINUE.'/' TYPE:''N''<CR>;TO START OVER.'/
25000		2' TYPE:''F'' TO SAVE VIS POGS IF FINISHED'/
25100		3' OR TYPE:''P'' TO PLOT ALL VIS POGS'/)
25200		ACCEPT 103,M
25300		IF(M.EQ.'N')GO TO 1
25400		IF(M.EQ.'P')GO TO 557
25500		IF(M.NE.'F')GO TO 120
25600	127	TYPE 121
25700	121	FORMAT(' TYPE A FIVE LETTER NAME FOR THIS PICTURE.'/)
25800		ACCEPT 3,NAM
25900		IF(NAM.EQ.'     ')GO TO 127
26000	557	MP=0
26100		DO 405 NP=1,4
26200		IF(KP(NP).NE.'VIS  ')GO TO 405
26300		MP=MP+1
26400		CALL IPAK(0,0,MN,1,10)
26500	405	CONTINUE
26600		IF(MP.EQ.0)GO TO 104
26700		NP=0
26800		JE=-1
26900	467	NP=NP+1
27000		IF(NP.GT.4)GO TO 468
27100		IF(KP(NP).NE.'VIS  ')GO TO 340
27200		GO TO 467
27300	468	IF(M.EQ.'P')GO TO 555
27400		CALL OFILE(1,NAM)
27500		WRITE(1)MN,(NN(K),K=1,MN)
27600		END FILE 1
27700		GO TO 1
27800	555	TYPE 587
27900	587	FORMAT(/' PLOTING ALL VIS POGS'/)
28000		CALL PLOTS(I)
28100		DO 556 I=1,MN
28200		CALL INXY(NX,NY,I)
28300		MO=3
28400		IF(NN(I))MO=2
28500	556	CALL PLOT(NX*NZ/10,NY*NZ/10,MO)
28600		GO TO 1
28700		END
28800	
28900		SUBROUTINE IPOG(NZ)
29000		COMMON KP(5),NP,NN(4000)
29100		DIMENSION MM(30),JP(4)
29200		CALL DPYSET(5,MM,30)
29300		CALL DPYTXT(100,-430,'POG1 POG2 POG3 POG4 ZOOM ',5)
29400		KP(5)=' REG '
29500		IF(NZ.LT.10)KP(5)=' --- '
29600		IF(NZ.GT.10)KP(5)=' +++ '
29700		CALL DPYTXT(100,-450,KP,5)
29800		DO 4 J=1,4
29900		JP(J)='     '
30000	4	IF(J.EQ.NP)JP(J)=' ↑↑  '
30100		CALL DPYTXT(100,-470,JP,4)
30200		CALL DPYOUT(5)
30300		CALL SETPOG(NP)
30400		RETURN
30500		END
30600		SUBROUTINE IPAK(NX,NY,MN,MP,NZ)
30700		COMMON KP(5),NP,NN(4000)
30800		MN=MN+1
30900		IX=(NX*10/NZ)+1024
31000		IY=(NY*10/NZ)+1024
31100		NN(MN)=MP*(NP*100000000+IX*10000+IY)
31200		CALL IPEN(NX,NY,MP,10)
31300		RETURN
31400		END
31500		SUBROUTINE IPEN(NX,NY,MP,NZ)
31600		IX=NX*NZ/10
31700		IF(IX.GT.950)IX=950
31800		IF(IX.LT.-950)IX=-950
31900		IY=NY*NZ/10
32000		IF(IY.GT.950)IY=950
32100		IF(IY.LT.-950)IY=-950
32200		IF(MP)GO TO 1
32300		CALL AIVECT(IX,IY)
32400		RETURN
32500	1	CALL AVECT(IX,IY)
32600		RETURN
32700		END
32800		SUBROUTINE INXY(NX,NY,MN)
32900		COMMON KP(5),NP,NN(4000)
33000		J=IABS(NN(MN))
33100		NY=MOD(J,10000)-1024
33200		NX=(MOD(J,100000000)/10000)-1024
33300		RETURN
33400		END
33500		SUBROUTINE IDRA(MN,NZ)
33600		COMMON KP(5),NP,NN(4000)
33700		DO 1 I=1,MN
33800		IF(IABS(NN(I)/100000000).NE.NP)GO TO 1
33900		CALL INXY(IX,IY,I)
34000		CALL IPEN(IX,IY,NN(I),NZ)
34100	1	CONTINUE
34200		RETURN
34300		END